home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL1NO5.ARC / GRIDLINE.LSP < prev    next >
Encoding:
Text File  |  1987-02-19  |  2.4 KB  |  59 lines
  1. ; --------------------------------------------------------------------------
  2. ;
  3. ;  CADENCE5.LSP                   Grid Line Work Display.
  4. ;
  5. ;  Written by: W.Kramer
  6. ;
  7. ; --------------------------------------------------------------------------
  8. (defun inlist (xyprmpt exp1)
  9. ;  XYPRMPT is string,  EXP1 is form list to update variable PS.
  10.   (setq v (getstring (strcat "\n" xyprmpt " Constant or Variable (C or V):"))) 
  11.          (setq lst nil)
  12.          (if (or (= v "C") (= v "c")) 
  13.             (progn
  14.              (setq v (getdist p1 (strcat "\n" xyprmpt " Constant spacing:")))
  15.              (setq n (getint "\nNumber of Cells:"))
  16.              (repeat n (setq lst (cons v lst)))) 
  17.             (progn
  18.              (setq ps p1)
  19.              (setq v (getdist ps (strcat "\n" xyprmpt " Variable spacing:")))
  20.              (while (boundp 'v)
  21.                  (setq ps (eval exp1))
  22.                  (setq lst (cons v lst))
  23.                  (setq v (getdist ps (strcat "\n" xyprmpt " Spacing:")))))) 
  24.     (reverse lst)) 
  25. ;
  26. (defun outlines (lst exp1 exp2)
  27. ;  LST is list to work on,  EXP1 is form list for line output.
  28. ;  EXP2 is form list for update of line starting point.
  29.    (setq ps p1 ex 0)
  30.    (while (= ex 0) ; ---  Repeat until 'lst is empty.
  31.        (command "LINE" ps (eval exp1) "")
  32.        (if (boundp 'lst)
  33.          (progn
  34.            (setq ps (eval exp2))
  35.            (setq lst (cdr lst)))
  36.          (setq ex 1)))) 
  37. ;
  38. (defun c:gridlines ()
  39.    (setq p1 (getpoint "\nLocate Lower Left corner of grid:"))
  40.    (if (null p1)
  41.       (prompt "\nInvalid entry")
  42.       (progn    ; --- Continue input section, ask for spacings.
  43.          (setvar "CMDECHO" 0) ; --- Disable AutoCAD command display.
  44.          (command "ORTHO" "ON") ; --- Switch Orthographic mode on.
  45.          (setq xlst (inlist "X-Axis" '(list (+ (car ps) v) (cadr ps))))
  46.          (setq ylst (inlist "Y-Axis" '(list (car ps) (+ (cadr ps) v))))
  47. ; --- Process section.
  48.          (setq dx 0.0 dy 0.0)
  49.          (setq p2 (list
  50.                     (+ (car p1)
  51.                        (foreach xx xlst (setq dx (+ dx xx))))
  52.                     (+ (cadr p1)
  53.                        (foreach xx ylst (setq dy (+ dy xx))))))
  54. ; --- Output section.
  55.          (outlines xlst '(list (car ps) (cadr p2))
  56.                         '(list (+ (car ps) (car lst)) (cadr ps)))
  57.          (outlines ylst '(list (car p2) (cadr ps))
  58.                         '(list (car ps) (+ (car lst) (cadr ps))))))) 
  59.